home *** CD-ROM | disk | FTP | other *** search
/ Power CD / Power CD ATARI-Rechner Lieben.iso / UTILITY / PROFILER / MENDEL.TST < prev    next >
Encoding:
Text File  |  1989-06-16  |  7.7 KB  |  209 lines
  1.     { Profiler-Testversion zu G:\PROFILER.SYS\DEMOS.PAS\MENDEL.PAS }  
  2.  
  3. CONST ___ = 46;
  4.    ___2 =6;
  5. VAR __ : INTEGER ;
  6. VAR _ : ARRAY [1..___] OF REAL ;
  7. VAR _2 : ARRAY [1..___2] OF REAL ;
  8. VAR _h : STRING; 
  9. VAR _f : TEXT;
  10. { 7. Bundeswettbewerb Informatik 1988/1989 } 
  11. { 1. Runde, Aufgabe 5 ; Autor M. Berger    }
  12. CONST MAX_ANZAHL_MERKMALE=4;
  13. TYPE ELTERNTEIL_DEF=(MUTTER,VATER,KIND);
  14. TYPNAME_DEF=(MUSTER,FARBE,FUEHLERFORM);
  15. MERKMALSPEICHER=STRING[20];
  16. DOMINANZ_LISTE_TEIL=RECORD
  17. MERKMAL:MERKMALSPEICHER;
  18. ANZ_REZES:INTEGER;
  19. REZESSIVE:ARRAY[1..MAX_ANZAHL_MERKMALE]
  20. OF MERKMALSPEICHER;
  21. END;
  22. DOMINANZ_LISTE_TYP=
  23. ARRAY[TYPNAME_DEF,1..MAX_ANZAHL_MERKMALE]
  24. OF DOMINANZ_LISTE_TEIL;
  25. VAR DOMINANZ_LISTE:DOMINANZ_LISTE_TYP;
  26. MERKMALE:ARRAY[ELTERNTEIL_DEF,TYPNAME_DEF,1..2]
  27. OF MERKMALSPEICHER;
  28. ANZ_KINDER:INTEGER;
  29. ELTERNTEIL:ELTERNTEIL_DEF;
  30. TYP:TYPNAME_DEF;
  31. ZAEHLER:INTEGER;
  32. PROCEDURE INITIALISIERUNG;
  33. VAR I:INTEGER;
  34. BEGIN _[1] := _[1] + 1 ;  _2[1] := _2[1] + 1 ;  
  35. FOR TYP:=MUSTER TO FUEHLERFORM DO BEGIN _[3] := _[3] + 1 ;  
  36. FOR I:=1 TO MAX_ANZAHL_MERKMALE DO BEGIN _[4] := _[4] + 1 ;  
  37. DOMINANZ_LISTE[TYP,I].MERKMAL:=''  END  END  ; 
  38. DOMINANZ_LISTE[MUSTER,1].MERKMAL:='uni'  ; 
  39. DOMINANZ_LISTE[MUSTER,1].ANZ_REZES:=3  ; 
  40. DOMINANZ_LISTE[MUSTER,1].REZESSIVE[1]:='uni'  ; 
  41. DOMINANZ_LISTE[MUSTER,1].REZESSIVE[2]:='schwarz gepunktet'  ; 
  42. DOMINANZ_LISTE[MUSTER,1].REZESSIVE[3]:='schwarz gestreift'  ; 
  43. DOMINANZ_LISTE[MUSTER,2].MERKMAL:='schwarz gepunktet'  ; 
  44. DOMINANZ_LISTE[MUSTER,2].ANZ_REZES:=2  ; 
  45. DOMINANZ_LISTE[MUSTER,2].REZESSIVE[1]:='schwarz gepunktet'  ; 
  46. DOMINANZ_LISTE[MUSTER,2].REZESSIVE[2]:='schwarz gestreift'  ; 
  47. DOMINANZ_LISTE[MUSTER,3].MERKMAL:='schwarz gestreift'  ; 
  48. DOMINANZ_LISTE[MUSTER,3].ANZ_REZES:=1  ; 
  49. DOMINANZ_LISTE[MUSTER,3].REZESSIVE[1]:='schwarz gestreift'  ; 
  50. DOMINANZ_LISTE[FARBE,1].MERKMAL:='rot'  ; 
  51. DOMINANZ_LISTE[FARBE,1].ANZ_REZES:=3  ; 
  52. DOMINANZ_LISTE[FARBE,1].REZESSIVE[1]:='rot'  ; 
  53. DOMINANZ_LISTE[FARBE,1].REZESSIVE[2]:='grün'  ; 
  54. DOMINANZ_LISTE[FARBE,1].REZESSIVE[3]:='blau'  ; 
  55. DOMINANZ_LISTE[FARBE,2].MERKMAL:='gelb'  ; 
  56. DOMINANZ_LISTE[FARBE,2].ANZ_REZES:=3  ; 
  57. DOMINANZ_LISTE[FARBE,2].REZESSIVE[1]:='gelb'  ; 
  58. DOMINANZ_LISTE[FARBE,2].REZESSIVE[2]:='rot'  ; 
  59. DOMINANZ_LISTE[FARBE,2].REZESSIVE[3]:='blau'  ; 
  60. DOMINANZ_LISTE[FARBE,3].MERKMAL:='grün'  ; 
  61. DOMINANZ_LISTE[FARBE,3].ANZ_REZES:=3  ; 
  62. DOMINANZ_LISTE[FARBE,3].REZESSIVE[1]:='grün'  ; 
  63. DOMINANZ_LISTE[FARBE,3].REZESSIVE[2]:='gelb'  ; 
  64. DOMINANZ_LISTE[FARBE,3].REZESSIVE[3]:='blau'  ; 
  65. DOMINANZ_LISTE[FARBE,4].MERKMAL:='blau'  ; 
  66. DOMINANZ_LISTE[FARBE,4].ANZ_REZES:=1  ; 
  67. DOMINANZ_LISTE[FARBE,4].REZESSIVE[1]:='blau'  ; 
  68. DOMINANZ_LISTE[FUEHLERFORM,1].MERKMAL:='gerade'  ; 
  69. DOMINANZ_LISTE[FUEHLERFORM,1].ANZ_REZES:=2  ; 
  70. DOMINANZ_LISTE[FUEHLERFORM,1].REZESSIVE[1]:='gerade'  ; 
  71. DOMINANZ_LISTE[FUEHLERFORM,1].REZESSIVE[2]:='gekrümmt'  ; 
  72. DOMINANZ_LISTE[FUEHLERFORM,2].MERKMAL:='gekrümmt'  ; 
  73. DOMINANZ_LISTE[FUEHLERFORM,2].ANZ_REZES:=1  ; 
  74. DOMINANZ_LISTE[FUEHLERFORM,2].REZESSIVE[1]:='gekrümmt'  ; 
  75.  ;IF _2[1] > _[2] THEN _[2] := _2[1]; _2[1]:=_2[1]-1; END ;
  76. PROCEDURE EINGABE;
  77. BEGIN _[5] := _[5] + 1 ;  _2[2] := _2[2] + 1 ;  
  78. CLRSCR  ; WRITELN('Mendels Land  (bwINF 7 [88/89];Aufgabe 5)') ; WRITELN  ;
  79. FOR ELTERNTEIL:=MUTTER TO VATER DO BEGIN _[7] := _[7] + 1 ;  
  80. WRITE(' Bitte Merkmale ') ; 
  81. IF ELTERNTEIL=MUTTER
  82. THEN BEGIN _[8] := _[8] + 1 ;  
  83. WRITE('der Mutter ')
  84.  END  ELSE BEGIN _[9] := _[9] + 1 ; 
  85. WRITE('des Vaters ') END  ; 
  86. WRITELN('angeben') ; 
  87. FOR TYP:=MUSTER TO FUEHLERFORM DO BEGIN _[10] := _[10] + 1 ;  
  88. WRITE('  Bitte ') ; 
  89.  BEGIN _[11] := _[11] + 1 ; CASE TYP OF 
  90. MUSTER: BEGIN _[12] := _[12] + 1 ; WRITE('Muster ') END  ; 
  91. FARBE: BEGIN _[13] := _[13] + 1 ; WRITE('Flügelfarbe ') END  ; 
  92. FUEHLERFORM: BEGIN _[14] := _[14] + 1 ; WRITE('Fühlerform ') END  ; 
  93.  END END  ; 
  94. WRITE('eingeben : ') ;
  95. READLN(MERKMALE[ELTERNTEIL,TYP,1]) ;
  96.  END  ; 
  97.  END  ; 
  98. WRITE('Anzahl der Kinder eingeben : ') ; READLN(ANZ_KINDER) ; 
  99.  ;IF _2[2] > _[6] THEN _[6] := _2[2]; _2[2]:=_2[2]-1; END ;
  100. PROCEDURE ERMITTLE_REZESSIVE_MERKMALE;
  101. VAR I:INTEGER;
  102. BEGIN _[15] := _[15] + 1 ;  _2[3] := _2[3] + 1 ;  
  103. FOR ELTERNTEIL:=MUTTER TO VATER DO BEGIN _[17] := _[17] + 1 ;  
  104. FOR TYP:=MUSTER TO FUEHLERFORM DO BEGIN _[18] := _[18] + 1 ;  
  105. MERKMALE[ELTERNTEIL,TYP,2]:=''  ; 
  106. I:=0  ;
  107. REPEAT _[19] := _[19] + 1 ; 
  108. I:=I+1  ;
  109. IF DOMINANZ_LISTE[TYP,I].MERKMAL=MERKMALE[ELTERNTEIL,TYP,1]
  110. THEN BEGIN _[20] := _[20] + 1 ;  
  111. MERKMALE[ELTERNTEIL,TYP,2]:=DOMINANZ_LISTE[TYP,I].REZESSIVE 
  112. [RANDOM(DOMINANZ_LISTE[TYP,I].ANZ_REZES)+1] END  ;
  113.  UNTIL MERKMALE[ELTERNTEIL,TYP,2]<>''  ;
  114.  END  ;
  115.  END  ;
  116.  ;IF _2[3] > _[16] THEN _[16] := _2[3]; _2[3]:=_2[3]-1; END ;
  117. PROCEDURE ERBMERKMAL_ERMITTELN;
  118. VAR I:INTEGER;
  119. BEGIN _[21] := _[21] + 1 ;  _2[4] := _2[4] + 1 ;  
  120. FOR ELTERNTEIL:=MUTTER TO VATER DO BEGIN _[23] := _[23] + 1 ; 
  121. FOR TYP:=MUSTER TO FUEHLERFORM DO BEGIN _[24] := _[24] + 1 ; 
  122. I:=ROUND(INT(RANDOM*2))+1  ; 
  123. IF ELTERNTEIL=MUTTER THEN BEGIN _[25] := _[25] + 1 ;  
  124. MERKMALE[KIND,TYP,1]:=MERKMALE[ELTERNTEIL,TYP,I] END  ; 
  125. IF ELTERNTEIL=VATER THEN BEGIN _[26] := _[26] + 1 ; 
  126. MERKMALE[KIND,TYP,2]:=MERKMALE[ELTERNTEIL,TYP,I] END  ; 
  127.  END  ; 
  128.  END  ; 
  129.  ;IF _2[4] > _[22] THEN _[22] := _2[4]; _2[4]:=_2[4]-1; END ;
  130. PROCEDURE DOM_ERBMERKMAL_ERMITTELN;
  131. VAR I,U:INTEGER;
  132. SWAP_HLP:MERKMALSPEICHER;
  133. BEENDEN:BOOLEAN;
  134. BEGIN _[27] := _[27] + 1 ;  _2[5] := _2[5] + 1 ; 
  135. FOR TYP:=MUSTER TO FUEHLERFORM DO BEGIN _[29] := _[29] + 1 ; 
  136. I:=0  ; 
  137. BEENDEN:=FALSE  ; 
  138. REPEAT _[30] := _[30] + 1 ; 
  139. I:=I+1  ; 
  140. IF MERKMALE[KIND,TYP,2]=
  141. DOMINANZ_LISTE[TYP,I].MERKMAL
  142. THEN BEGIN _[31] := _[31] + 1 ; 
  143. FOR U:=1 TO DOMINANZ_LISTE[TYP,I].ANZ_REZES DO BEGIN _[32] := _[32] + 1 ; 
  144. IF DOMINANZ_LISTE[TYP,I].REZESSIVE[U]
  145. =MERKMALE[KIND,TYP,1]
  146. THEN BEGIN _[33] := _[33] + 1 ;  
  147. SWAP_HLP:=MERKMALE[KIND,TYP,2] ;
  148. MERKMALE[KIND,TYP,2]:=MERKMALE[KIND,TYP,1] ; 
  149. MERKMALE[KIND,TYP,1]:=SWAP_HLP  ; 
  150. BEENDEN:=TRUE  ;
  151.  END  ;
  152.  END  ;
  153.  END  ;
  154.  UNTIL(BEENDEN)OR(I=MAX_ANZAHL_MERKMALE) ; 
  155.  END  ; 
  156.  ;IF _2[5] > _[28] THEN _[28] := _2[5]; _2[5]:=_2[5]-1; END ;
  157. PROCEDURE AUSGABE;
  158. VAR X:CHAR;
  159. BEGIN _[34] := _[34] + 1 ;  _2[6] := _2[6] + 1 ;  
  160. CLRSCR  ;
  161. WRITELN('Mendels Land  (bwINF 7 [88/89];Aufgabe 5)') ; WRITELN  ; 
  162. FOR ELTERNTEIL:=MUTTER TO KIND DO BEGIN _[36] := _[36] + 1 ;  
  163. WRITE(' Merkmale') ; 
  164. IF ELTERNTEIL=MUTTER
  165. THEN BEGIN _[37] := _[37] + 1 ;  
  166. WRITELN(' der Mutter :')
  167.  END  ELSE BEGIN _[38] := _[38] + 1 ; 
  168. IF ELTERNTEIL=VATER
  169. THEN BEGIN _[39] := _[39] + 1 ;  
  170. WRITELN(' des Vaters :')
  171.  END  ELSE BEGIN _[40] := _[40] + 1 ; 
  172. WRITELN(' des ',ZAEHLER,'. Kindes :') END  END  ; 
  173. FOR TYP:=MUSTER TO FUEHLERFORM DO BEGIN _[41] := _[41] + 1 ;  
  174. WRITE('   - ') ; 
  175.  BEGIN _[42] := _[42] + 1 ; CASE TYP OF 
  176. MUSTER: BEGIN _[43] := _[43] + 1 ; WRITE('Muster :') END  ; 
  177. FARBE: BEGIN _[44] := _[44] + 1 ; WRITE('Farbe  :') END  ; 
  178. FUEHLERFORM: BEGIN _[45] := _[45] + 1 ; WRITE('Fühler :') END  ; 
  179.  END END  ; 
  180. WRITELN(' Dominant ',MERKMALE[ELTERNTEIL,TYP,1],
  181. ' ; Rezessiv ',MERKMALE[ELTERNTEIL,TYP,2]) ;
  182.  END  ;
  183.  END  ;
  184. READ(KBD,X) ; 
  185.  ;IF _2[6] > _[35] THEN _[35] := _2[6]; _2[6]:=_2[6]-1; END ;
  186. BEGIN FOR __:= 1 TO ___ DO _[__]:=0;  FOR __:= 1 TO ___2 DO _2[__]:=-1; 
  187. INITIALISIERUNG  ; 
  188. EINGABE  ; 
  189. ERMITTLE_REZESSIVE_MERKMALE  ; 
  190. FOR ZAEHLER:=1 TO ANZ_KINDER DO BEGIN _[46] := _[46] + 1 ; 
  191. ERBMERKMAL_ERMITTELN  ;
  192. DOM_ERBMERKMAL_ERMITTELN  ;
  193. AUSGABE  ;
  194.  END  ;
  195. ;ASSIGN(_f,'G:\PROFILER.SYS\TESTFILE.TST\MENDEL.WRT');
  196. REWRITE(_f);
  197. WRITELN(_f,'(c)1989mkbmeersaukleintier');
  198. WRITELN(_f,'G:\PROFILER.SYS\DEMOS.PAS\MENDEL.PAS');
  199. WRITELN(_f,'nein');
  200. WRITELN(_f,'46.0');
  201. FOR __ := 1 TO ___ DO BEGIN 
  202. STR(_[__],_h);
  203. WRITELN(_f,_h); END;
  204. CLOSE(_f);
  205. WRITELN;WRITELN;
  206. WRITELN('-> Profile-Testlauf beendet. Werte in G:\PROFILER.SYS\TESTFILE.TST\MENDEL.WRT');
  207. WRITELN('-> Bitte profile_2.prg starten. ');
  208. END.
  209.